perm filename SC1.F4[COL,LCS] blob
sn#351029 filedate 1978-04-24 generic text, type T, neo UTF8
00100 C THIS PROGRAM IS THE PROPERTY OF LELAND SMITH, PROFESSOR OF MUSIC
00200 C AT STANFORD UNIVERSITY. IT MAY NOT BE COPIED OR ALTERED IN ANY
00300 C WAY WITHOUT WRITTEN PERMISSION OF THE AUTHOR.
00400
00500
00600 C 4/78 ********** SCORE ********** LELAND SMITH, SEP.1969
00700
00800 C THIS PROGRAM WRITES NOTE LISTS FOR THE PDP10 SOUND
00900 C GENERATION PROGRAM.
01000 C IF # OF INSTS IS CHANGED, ALSO CHANGE # IN 'INFO'('HELP') FORMAT.
01100 C THESE ROUTINES MUST BE COMPILED WITH 'F40' (OLD DEC FORTRAN 4)
01110 C THE SOURCES ARE: SC1.F4, SC2.F4, SC3.F4, SCANR.F4, SUBR.F4, SCR.FAI
01120 C SUBR.F4 IS THE MICROTONE SUBROUTINE AND MAY BE OMITTED.
01130 C SCR.FAI MUST BE COMPILED WITH 'FAIL'
01140 C USE THE FOLLOWING LOAD COMMAND:
01150 C R LOADER <CR>
01160 C SC1,SC2,SC3,SCANR,SUBR,SCR,/LLIB40$
01170 C /LLIB40 LOADS THE OLD FORTRAN LIBRARY. (VERY ESSENTIAL)
01180 C IF DDT IS DESIRED ADD /D IN FRONT OF SC1.
01190 C TO CREATE A SINGLE .REL FILE FOR USE WITH A USER-ADDED
01195 C SUBROUTINE TYPE: COPY S.REL←SC1.R3,SC2.REL,SC3.REL,SCANR.REL,SCR.REL
01197 C THEN WHEN THIS IS LOADED BE SURE TO INCLUDE /LLIB40 AT END.
01198
01200 C (QUAD AND QUADO ROUTINES ARE NOT YET WRITTEN.)
01300 C IF A DIFFERENT SUBROUTINE IS USED IT MUST HAVE A HEADING AS FOLLOWS:
01400 C SUBROUTINE SUBR
01500 C COMMON /INS/ INST(27),BG(60)
01600 C COMMON P(30),INUM,IPAR,CNT(27),BT,PL(48),IREST,DF,DUR(27)
01700 C INUM=INST# IPAR=PARAM#
01800 C BT=BASIC TIME P1 WHEN SUBROUTINE IS CALLED
01900 C IF IREST IS <0, THAT NOTE WILL BE A REST.
02000 C INST=INST. NAME, BG=INSTS' BEGIN TIMES.
02100 C NOTE #S IN SUBROUTINE: (1-84) C4=37 FS4=43 C5=49 ETC.
02200 C F1=86 F15=100 (NO F16!)
02300
02400 COMMON /Q/ BNW(100),NWZ /INS/INST(27),BG(60) /TYP/SOS,JOUT,
02500 1 LN,ITYP,TPALN(4),JED /SAM/ISAM
02600 CC 7/74 COLGATE COMMON/TYP/ IS FOR COLTTY ROUT.
02700 C SEE LABEL 1774 AND BELOW RE. BUFFER LIMIT.
02800 COMMON/VV/LIMIT,V(2000) /A/ROFF(27),NP(27),PCH(27,32),
02900 1 RDEV(27),IPT(27,31),XT(27),OTH(20,16),SCAL(101)
03000 1 ,P1(27),JFM(4),COPY(30),IFM(80)
03100 1 ,FINM(6),TINST(5),ENFI(5),TEDIT(4),INVIS(27)
03200 DIMENSION LIST(78),JNP(80)
03300 C WITH VX,IOUT AT 70 AND IFM AT 80 OK FOR ONLY
03400 C 40 LIT CHARS + 30 PARAMS PER INST.
03500 C 60 BG TIMES AVAILABLE. FOR INSTS AND INSERTS AND EDITS.
03600 COMMON P(30),J,L,CNT(27),BT,PL(48),MK,DF,DUR(27)
03700 1/E/IQ(27),KL,X,ZPAR,KA,LK,NNUM,JJ,JA,ISUB,NFLG,IXX,ISEMI,IQT
03800 1 ,INP(144),VX(70),ISCA(12),IDAT(11),IAMP,K,KN,M,ML,CODE,IBLA
03900 COMMON/B/MOT,PR,T5,NINS,I,TP,RA,KZY,NWX,INONLY,MX,
04000 1 Y,Z,ISLAC,MZ,N,IDALL,JC,JG,RB,IJ,IX,BW,KB,NL,RC,W,
04100 1 ZZ,CHN,YY
04200 1 /D/TF,AMPFAC,OP1,DURX,IXIN,IFLNM
04300 1 /C/LPAR,IPRN,QX,RETRO,INVRT,ICON,LCNT,
04400 1 PARENS,JZ,BY,MLX,IZ,ALL,JD,LEND,QTS,ITMP,
04500 1 LP,ILIT,NLIT,KTMP,IC,RAX,RD,IA
04600 C /C/=26
04700 EQUIVALENCE (LIST,IFM(3)),(JNP,INP)
04800 DATA KZY/27/,ISEMI/';'/,IQT/'"'/,LIMIT/2000/
04900 1, JFM(3)/','/
05000 C IAA=A ID=D IE=E IF=F IEN=N IPP=P ISS=S ITT=T
05100 DATA IBLA/' '/,IXX/'X'/
05200 1 ,ISCA/'C','P','D','O','E','F','PLAY;','G','S','A','T','B'/
05300 1 ,IDAT/'0','1','2','3','4','5','6','7','8','9','.'/
05350 CALL ERRSET(0)
05400 ISAM=0
05500 LPAR=0
05600 IPRN=0
05700 QX=0.
05800 MOT=0
05900 RETRO=-1.
06000 INVRT=-1
06100 ICON=-1
06200 LCNT=1
06300 PARENS=0
06400 JZ=1
06500 CALL RNDINT
06600 C INIT RAND NUM GENERATOR.
06700 CC PR=0
06800 IAMP=0
06900 C IAMP IS 'BLANK LINE'FLAG ON PP1-3.
07000 T5=0
07100 NINS=0
07200 K=0
07300 IDALL=-1
07400 QTS=-1.
07500 KB=0
07600 NWZ=1
07700 BNW(1)=0
07800 I=1
07900 KL=0
08000 TP=0
08100 RA=0
08200 CHN=0
08300 DO 127 K=1,77,3
08400 127 LIST(K)=0
08500 C INITIALIZES MOTIVIC LIST FOR ERROR FINDING ROUTINE.
08600 NWX=0
08700 BY=-1
08800 DO 1128 K=1,KZY
08900 INVIS(K)=0
09000 INST(K)=0
09100 CNT(K)=0
09200 RDEV(K)=0
09300 C RDEV IS FOR RAND DEVIATIONS AT RUN TIME
09400 NP(K)=0
09500 IQ(K)=0
09600 C IQ IS FOR RESTART FLAG
09700 IPT(K,1)=0
09800 DO 1128 L=1,32
09900 1128 PCH(K,L)=0
10000
10100 ITYP=-1
10200 C TYPE 'FILE NAME', TEMPO FACTOR(0=1), AMPL.FACT(0=1),
10300 C SECONDS TO BE OMITTED, DUR AT CUTOFF.
10400 JED=-1
10500 2112 TYPE 8002
10600 1112 ACCEPT 77732,JNP
10700 JFM(4)='5F)'
10800 JFM(1)=' (A'
10900 C FOR FREE 'A' FORMAT
11000 CALL FMT(JFM,JNP,MLX)
11100 REREAD JFM,K,TF,AMPFAC,OP1,DURX
11200 C JFM IS THE CURRENT FORMAT STATEMENT
11300 IF(K.NE.'999')GO TO 999
11400 ISAM=-1
11500 TYPE 1999
11600 GO TO 2112
11700 C NEWMUS SWITCH (ISAM) CHANGES PLAY STATEMENT FOR NEWMUS FORMAT.
11800 1999 FORMAT(' NEWMUS SWITCH HAS BEEN SET.')
11900 999 IF(K.NE.'EDIT')GO TO 3112
12000 JED=0
12100 GO TO 2112
12200 C 'E(DIT)' GOES TO EDIT MODE
12300 3112 IF(TF.EQ.0)TF=1.
12400 IF(AMPFAC.EQ.0)AMPFAC=1.
12500 21122 IF(K.NE.'TYPE')GO TO 128
12600 ITYP=0
12700 DATA FINM/30H(' TYPE OUTPUT FILE NAME'/) /
12800 IFLNM='TYPED'
12900 CC IFLNM='FOR21'
13000 CC REWIND 21
13100 CALL OFILE(21,IFLNM)
13200 GO TO 3127
13300 8001 FORMAT(A5,5F)
13400 77732 FORMAT(80A1)
13500 300 FORMAT(I,3F)
13600 128 IF(K.EQ.'INFO')GO TO 1280
13700 IF(K.NE.'HELP')GO TO 3128
13800 1280 TYPE 8002
13900 TYPE 1113
14000 TYPE 118
14100 TYPE 1114
14200 TYPE 8002
14300 GO TO 1112
14400 118 FORMAT(' TO DSK=1, TTY=2, BOTH=0, LPT=22'/)
14500 C118 FORMAT(' TO DSK=1, TTY=2, BOTH=0, LPT=22, PROOF=3, DEBUG=4'/)
14600 CC*** TEMPORARY ***8002 FORMAT(' TYPE FILE NAME'/)
14700 8002 FORMAT(' TYPE FILE NAME-- '$)
14800 1113 FORMAT(' NAME TF AMPFAC OMIT" DUR"'/)
14900 1114 FORMAT(' N1, N2=RAN NUM, N3=0 LISTS INPUT, N4=SINGLE INST.'/
15000 1 ' IF -- N1=3 DURS ONLY, =4 V ARRAY'/
15100 1 3X' 27 INSTRUMENTS ARE AVAILABLE'/)
15200
15300 3128 IF(K.NE.IBLA)IFLNM=K
15400 CALL IFILE(23,IFLNM)
15500 READ(23,300)LN,IXIN
15600 C CHECK FOR LINE NUMBERS ONLY.
15700 REREAD 8001,K
15800 IF(K.NE.'COMME')GO TO 3000
15900 3001 READ(23,77732)JNP
16000 IF(JNP(3).NE.ISEMI)GO TO 3001
16100 GO TO 3127
16200 C TO READ HEADER OF 'ET' FILES
16300 3000 REWIND 23
16400 CALL IFILE(23,IFLNM)
16500
16600 CC3127 ISLAC=(IFLNM.AND."003777777777).OR."550000000000
16700 C MAGIC TO CHANGE LFT. LETTER TO Z(INP. ABCDE BECOMES ZBCDE.DAT)
16800 3127 ISLAC=IFLNM
16900 C NOW USES MY FORNAM SUBROUTINE TO PUT EXTENSION .SCR ON OUTPUT
17000 5127 TYPE 118
17100 IF(DURX.EQ.0)DURX=19999.
17200 IXIN=1
17300 INONLY=-1
17400 ACCEPT 300,MX,X,Y,Z
17500 IF(MX.NE.99)GO TO 6127
17600 TYPE FINM
17700 ACCEPT 8001,ISLAC
17800 GO TO 5127
17900 6127 IF(Z.NE.0)INONLY=Z
18000 IF(X.NE.0)IXIN=X
18100 C MX=3 GIVES DURS ONLY
18200 C TO SUPPRESS LIST OF INPUT DATA, TYPE ANY 3RD NUM. (BUT 9.)
18300 C (1 1 1 =RECORD,RAN. NUM=1,SUPPRESS INPUT.)
18400 MZ=0
18500 JOUT=5
18600 C 5=OUTPUT TO TTY
18700 SOS=-1.
18800 IF(Y.NE.0)SOS=0
18900 C IF 3RD NUM=0, EDIT FILE WILL PRINT AS IT IS READ.
19000 IF(MX.NE.22)GO TO 2107
19100 CC JOUT=3
19200 C DIRECT TO LPT AT COLGATE 6/74
19300 JOUT=22
19400 REWIND 22
19500 2107 IF(MX.GT.1)GO TO 277
19600 MX=MX-2
19700 CALL FORNAM(ISLAC,'SCR')
19800 277 IF(MX.EQ.-2)GO TO 77
19900 IF(MX.EQ.2)GO TO 77
20000 IF(MX.NE.22)GO TO 177
20100 77 MZ=-1
20200 177 IF(MX.EQ.4)MZ=-4
20300 CALL READIT
20400 END